home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 033a / dircnt11.zip / DIRCOUNT.PAS < prev   
Pascal/Delphi Source File  |  1991-07-24  |  6KB  |  271 lines
  1.  
  2. (*
  3.  * DirCount - Count file directory entries and insert headers with
  4.  *            file information.
  5.  *
  6.  * Written by Samuel H. Smith, 12-30-88
  7.  *
  8.  *)
  9.  
  10. const
  11.    version   = 'DirCount 1.1, 07-24-91';
  12.  
  13. var
  14.    console:    text;
  15.    ctlfd:      text;
  16.  
  17.    bbsname:    string;
  18.    dirfile:    string;
  19.    title:      string;
  20.    dirnum:     integer;
  21.  
  22.    ibuf:       array[1..20480] of byte;
  23.    obuf:       array[1..20480] of byte;
  24.    line:       string;
  25.    sizes:      longint;
  26.    tsizes:     longint;
  27.    files:      word;
  28.    tfiles:     word;
  29.  
  30.  
  31. (* --------------------------------------------------------- *)
  32. function itoa (n: longint): string;
  33. var
  34.    tstr:          string;
  35.  
  36. begin
  37.    str(n, tstr);
  38.    itoa := tstr;
  39. end;
  40.  
  41.  
  42. (* --------------------------------------------------------- *)
  43. function insert_commas(s: string): string;
  44. var
  45.    i: integer;
  46. begin
  47.    i := length(s);
  48.    while i > 3 do
  49.    begin
  50.       dec(i,3);
  51.       insert(',',s,i+1);
  52.    end;
  53.  
  54.    insert_commas := s;
  55. end;
  56.  
  57.  
  58. (* --------------------------------------------------------- *)
  59. function numtostr(n: longint; width: integer): string;
  60. var
  61.    s: string;
  62.    t: string;
  63.    p: integer;
  64. begin
  65.    if n < 100000 then
  66.       s := insert_commas( itoa(n) ) + '    '
  67.    else
  68.  
  69.    if n < 1024000 then
  70.       s := insert_commas( itoa(n shr 10) ) + ' K  '
  71.    else
  72.  
  73.    begin
  74.       str((n shr 10) / 1000:0:2,t);
  75.       s := insert_commas( copy(t,1,length(t)-3) ) +
  76.            copy(t,length(t)-2,3) + ' MEG';
  77.    end;
  78.  
  79.    if width = 0 then
  80.       while s[length(s)] = ' ' do
  81.          dec(s[0]);
  82.  
  83.    while length(s) < width do
  84.       s := ' ' + s;
  85.  
  86.    numtostr := s;
  87. end;
  88.  
  89.  
  90. (* --------------------------------------------------------- *)
  91. function isfile: boolean;
  92. begin
  93.    isfile := (length(line) > 35) and
  94.              (line[26] = '-')  and (line[29] = '-') and
  95.              (line[21] >= '0') and (line[21] <= '9') and
  96.              (line[24] >= '0') and (line[24] <= '9');
  97. end;
  98.  
  99.  
  100. (* --------------------------------------------------------- *)
  101. procedure count_files;
  102. var
  103.    size: longint;
  104.    err:  integer;
  105.    tmp:  string;
  106.    ifd:  text;
  107.  
  108. begin
  109.    files := 0;
  110.    sizes := 0;
  111.  
  112.    assign(ifd,dirfile);
  113.    {$i-} reset(ifd); {$i+}
  114.    if ioresult <> 0 then
  115.    begin
  116.       writeln(console,'Can''t open DIR file ',dirfile);
  117.       halt(99);
  118.    end;
  119.  
  120.    setTextBuf(ifd,ibuf);
  121.    write(console,'  Counting: ',dirfile,'':10,^M);
  122.  
  123.    while not eof(ifd) do
  124.    begin
  125.       readln(ifd,line);
  126.       if isfile then
  127.       begin
  128.          inc(files);
  129.          tmp := copy(line,13,9);
  130.          while tmp[1] = ' ' do
  131.             delete(tmp,1,1);
  132.          val(tmp,size,err);
  133.          sizes := sizes + size;
  134.       end;
  135.    end;
  136.  
  137.    close(ifd);
  138. end;
  139.  
  140.  
  141. (* --------------------------------------------------------- *)
  142. procedure update_dirfile;
  143. var
  144.    ifd:     text;
  145.    ofd:     text;
  146.    tmp:     string;
  147.  
  148. begin
  149.    assign(ifd,dirfile);
  150.    {$i-} reset(ifd); {$i+}
  151.    if ioresult <> 0 then
  152.    begin
  153.       writeln(console,'Can''t open DIR file ',dirfile);
  154.       halt(99);
  155.    end;
  156.  
  157.    assign(ofd,dirfile+'$');
  158.    {$i-} rewrite(ofd); {$i+}
  159.    if ioresult <> 0 then
  160.    begin
  161.       writeln(console,'Can''t create tempfile ',dirfile,'$');
  162.       halt(99);
  163.    end;
  164.  
  165.    setTextBuf(ifd,ibuf);
  166.    setTextBuf(ofd,obuf);
  167.    write(console,'Formatting: ',dirfile,'':10,^M);
  168.  
  169.    repeat
  170.       readln(ifd,line);
  171.    until isfile or eof(ifd);
  172.  
  173.    writeln(ofd);
  174.    writeln(ofd,'':38-length(bbsname) div 2,bbsname);
  175.    writeln(ofd);
  176.    writeln(ofd,'':38-length(title) div 2,title);
  177.  
  178.    tmp := itoa(files) + ' files using ' + numtostr(sizes,0) + ' bytes';
  179.    writeln(ofd,'':38-length(tmp) div 2,tmp);
  180.  
  181.    writeln(ofd);
  182.    writeln(ofd,' File Name      Size     Date                  File Description');
  183.    writeln(ofd,'------------  -------  --------  ---------------------------------------------');
  184.    writeln(ofd);
  185.  
  186.    writeln(ofd,line);
  187.    while not eof(ifd) do
  188.    begin
  189.       readln(ifd,line);
  190.       writeln(ofd,line);
  191.    end;
  192.  
  193.    close(ofd);
  194.    close(ifd);
  195.  
  196.    {$i-} erase(ifd); {$i+}
  197.    if ioresult <> 0 then
  198.    begin
  199.       writeln(console,'Can''t erase old dirfile ',dirfile);
  200.       halt(99);
  201.    end;
  202.  
  203.    {$i-} rename(ofd,dirfile); {$i+}
  204.    if ioresult <> 0 then
  205.    begin
  206.       writeln(console,'Can''t rename new dirfile ',dirfile,'$ to ',dirfile);
  207.       halt(99);
  208.    end;
  209.  
  210. end;
  211.  
  212.  
  213. (* --------------------------------------------------------- *)
  214. begin
  215.    assign(console,'CON');
  216.    rewrite(console);
  217.    writeln(console,version,';  Copyright 1988, 1991 Samuel H. Smith');
  218.    writeln(console);
  219.  
  220.    if paramcount <> 1 then
  221.    begin
  222.       writeln(console,'Usage:    DirCount configfile [>summary]');
  223.       writeln(console,'Example:  DirCount COUNT.CNF >\PCB\GEN\BLT16');
  224.       halt(99);
  225.    end;
  226.  
  227.    assign(ctlfd,paramstr(1));
  228.    {$i-} reset(ctlfd); {$i+}
  229.    if ioresult <> 0 then
  230.    begin
  231.       writeln(console,'Can''t open configuration file ',paramstr(1));
  232.       halt(99);
  233.    end;
  234.  
  235.    readln(ctlfd,bbsname);
  236.    dirnum := 0;
  237.    tfiles := 0;
  238.    tsizes := 0;
  239.  
  240.    writeln;
  241.    writeln('':38-length(bbsname) div 2,bbsname);
  242.    writeln;
  243.  
  244.    writeln(' Dir   Files      Bytes                       Description');
  245.    writeln('----- ------- -------------  ----------------------------------------------');
  246.  
  247.    while not eof(ctlfd) do
  248.    begin
  249.       readln(ctlfd,dirfile);
  250.       readln(ctlfd,title);
  251.       inc(dirnum);
  252.  
  253.       count_files;
  254.  
  255.       writeln(insert_commas( itoa(dirnum)):4,
  256.               insert_commas( itoa(files)):8,
  257.               numtostr(sizes,14),'    ',title);
  258.       tfiles := tfiles + files;
  259.       tsizes := tsizes + sizes;
  260.  
  261.       update_dirfile;
  262.    end;
  263.  
  264.    write(console,'':60,^M);
  265.    close(ctlfd);
  266.  
  267.    writeln('      ======= ===============');
  268.    writeln(insert_commas( itoa(tfiles) ):12,numtostr(tsizes,14));
  269. end.
  270.  
  271.